home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Shareware World / Comms & Internet / HTML and CSS modes / HTML and CSS Modes / htmlEngine.tcl < prev    next >
Text File  |  1998-11-01  |  52KB  |  1,575 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlEngine.tcl"
  6.  #                                    created: 96-04-29 21.31.28 
  7.  #                                last update: 98-11-01 16.59.19 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.3
  13.  # 
  14.  # Copyright 1996-1998 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlEngine.tcl {} {}
  25.  
  26. proc htmlIsInteger {str} {
  27.     return [regexp {^-?[0-9]+$} [string trim $str]]
  28. }
  29.  
  30. # Checks to see if the current window is empty, except for whitespace.
  31. proc htmlIsEmptyFile {} {
  32.     return [catch {search -s -f 1 -r 1 {[^ \t\r\n]+} 0}]
  33. }
  34.  
  35. # Removes all tags from a string.
  36. proc htmlTagStrip {str} {
  37.     regsub -all {<[^<>]*>} $str "" str
  38.     return $str
  39. }
  40.  
  41. # Quoting of strings for meta tags.
  42. proc htmlQuote {str} {
  43.     regsub -all "#" $str {#;} str
  44.     regsub -all "\"" $str {#qt;} str
  45.     regsub -all "<" $str {#lt;} str
  46.     regsub -all ">" $str {#gt;} str
  47.     return $str
  48. }
  49.  
  50. proc htmlUnQuote {str} {
  51.     regsub -all {#qt;} $str "\"" str
  52.     regsub -all {#lt;} $str "<" str
  53.     regsub -all {#gt;} $str ">" str
  54.     regsub -all {#;} $str "#" str
  55.     return $str
  56. }
  57.  
  58.  
  59. # Find the version number of a program.
  60. # Returns 0 if any problem.
  61. proc htmlGetVersion {sig} {
  62.     if {![app::isRunning $sig] && [catch {app::launchBack $sig}]} {
  63.         return 0
  64.     }
  65.     set vers [AEBuild -r '$sig' core getd ---- "obj{want:type('prop'),from:null(),form:'prop',seld:type('vers')}"]
  66. #     set vers [objectProperty 'MACS' vers "obj {want:type(file), seld:$sig, form:fcrt, from:'null'()}"]
  67.     if {[regexp {vers\(«([0-9]+)} $vers dum vers]} {
  68.         return [string trimleft [string range $vers 0 1].[string range $vers 2 3] 0]
  69.     }
  70.     return 0
  71. }
  72.  
  73. proc htmlCommentStrings {} {
  74.     if {[htmlIsInContainer SCRIPT] || [htmlIsInContainer STYLE]} {
  75.         return [list "/* " " */"]
  76.     } else {
  77.         return [list "<!-- " " -->"]
  78.     }
  79. }
  80.  
  81. # Create a string for URL mapping in Big Brother.
  82. proc htmlURLmap {} {
  83.     global HTMLmodeVars
  84.     set urlmap {}
  85.     foreach hp $HTMLmodeVars(homePages) {
  86.         set fld "[htmlURLescape [lindex $hp 0] 1]/"
  87.         regsub -all ":" $fld "/" fld
  88.         set url [htmlURLescape "[lindex $hp 1][lindex $hp 2]"]
  89.         lappend urlmap "Msta:“$url”, Mend:“file:///$fld”"
  90.         append urlmap ","
  91.     }
  92.     set urlmap [string trimright $urlmap ","]
  93.     return $urlmap
  94. }
  95.  
  96. # Makes a line for browser error window.
  97. proc htmlBrwsErr {fil l lnum ln text path} {
  98.     return "$fil[format "%$l\s" ""]; Line $lnum:[format "%$ln\s" ""]$text\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$path\r"
  99. }
  100.  
  101. proc htmlSetWin {} {
  102.     insertColorEscape 0 1
  103.     insertColorEscape [nextLineStart [nextLineStart 0]] 0
  104.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  105.     setWinInfo dirty 0
  106.     setWinInfo read-only 1
  107.     scrollUpLine; scrollUpLine
  108.     refresh
  109. }
  110.     
  111. proc htmlIsTextFile {fil cmd} {
  112.     if {[file isdirectory $fil] || [getFileType $fil] != "TEXT"} {
  113.         $cmd "[file tail $fil] is not a text file."
  114.         return 0
  115.     }
  116.     return 1
  117. }
  118.  
  119. proc htmlAllSaved {msg} {
  120.     set dirty 0
  121.     foreach w [winNames] {
  122.         getWinInfo -w $w arr
  123.         if {$arr(dirty)} {set dirty 1; break}
  124.     }
  125.     if {$dirty} {
  126.         set yn [eval [concat askyesno $msg]]
  127.         if {$yn == "yes"} {saveAll}
  128.         return $yn
  129.     }
  130.     return yes
  131. }
  132.  
  133. # Determines in which home page folder a URL points to.
  134. # If none, return empty string.
  135. proc htmlInWhichHomePage {url} {
  136.     global HTMLmodeVars
  137.     foreach p $HTMLmodeVars(homePages) {
  138.         if {[string match "[lindex $p 1][lindex $p 2]*" $url]} {return [lindex $p 0]}
  139.     }
  140.     return ""
  141. }
  142.  
  143. # Asks for a folder and checks that it is not an alias.
  144. proc htmlGetDir {prompt} {
  145.     while {1} {
  146.         if {[file isdirectory [set folder [get_directory -p $prompt]]]} {
  147.             break
  148.         } else {
  149.             alertnote "Sorry! Cannot resolve aliases."
  150.         }
  151.     }
  152.     return [string trimright $folder :]
  153. }
  154.  
  155. proc htmlSetCase {elem} {
  156.     global HTMLmodeVars 
  157.     if {$HTMLmodeVars(useLowerCase)} { 
  158.         return [string tolower $elem] 
  159.     } else {
  160.         return [string toupper $elem] 
  161.     }
  162. }
  163.  
  164.  
  165. # Returns a list of all attributes used in any HTML element.
  166. proc htmlGetAllAttrs {} {
  167.     global htmlElemAttrOptional1 htmlElemAttrRequired1 htmlElemEventHandler1
  168.     
  169.     foreach elem [array names htmlElemAttrOptional1] {
  170.         if {[info exists htmlElemAttrRequired1($elem)]} {
  171.             append allHTMLattrs " " $htmlElemAttrRequired1($elem)
  172.         }
  173.         append allHTMLattrs " " $htmlElemAttrOptional1($elem)
  174.         if {[info exists htmlElemEventHandler1($elem)]} {
  175.             append allHTMLattrs " " [string toupper $htmlElemEventHandler1($elem)]
  176.         }
  177.     }
  178.     return $allHTMLattrs
  179. }
  180.  
  181.  
  182. # Snatch the current selection into htmlCurSel, set flag whether there is one
  183. proc htmlGetSel {} {
  184.     global htmlCurSel htmlIsSel
  185.     set htmlCurSel [string trim [getSelect]]
  186.     set htmlIsSel [string length $htmlCurSel]
  187. }
  188.  
  189.  
  190. # Insert one or two carriage returns at the insertion point if any
  191. # character preceding the insertion point (on the same line)
  192. # is a non-whitespace character.
  193. proc htmlOpenCR {indent {extrablankline 0}} {
  194.     set end [getPos]
  195.     set start [lineStart $end]
  196.     set text [getText $start $end]
  197.     if {![is::Whitespace $text]} {
  198.         set r "\r$indent"
  199.         if {$extrablankline} {append r "\r$indent"}
  200.         return $r
  201.     } elseif {$start > 0 } { 
  202.         set prevstart [lineStart [expr $start - 1 ]]
  203.         set text [getText $prevstart [expr $start - 1]]
  204.         if {![is::Whitespace $text] && $extrablankline} {
  205.             return "\r$indent"
  206.         } else { 
  207.             return [htmlFirstLineIndent $indent]
  208.         }
  209.     } else {
  210.         return [htmlFirstLineIndent $indent]
  211.     }
  212. }
  213.  
  214. # Insert a carriage return at the insertion point if any
  215. # character following the insertion point (on the same line)
  216. # is a non-whitespace character.
  217. proc htmlCloseCR {indent {start ""}} {
  218.     if {$start == ""} {set start [selEnd]}
  219.     if {![is::Whitespace [getText $start [nextLineStart $start]]]} {
  220.         return "\r$indent"
  221.     }
  222. }
  223.  
  224. # Insert up to two carriage return at the insertion point depending
  225. # on how many blank lines there are after the insertion point.
  226. proc htmlCloseCR2 {indent pos} {
  227.     set blank1 [is::Whitespace [getText $pos [nextLineStart $pos]]]
  228.     set blank2 [is::Whitespace [getText $pos [nextLineStart [nextLineStart $pos]]]]
  229.     if {!$blank1} {
  230.         return "\r$indent\r$indent"
  231.     } elseif {!$blank2} {
  232.         return "\r$indent"
  233.     }    
  234. }
  235.  
  236. proc HTML::electricSemi {} {
  237.     if {![htmlIsInContainer SCRIPT] && ![htmlIsInContainer STYLE]} {
  238.         insertText ";"
  239.         return
  240.     }
  241.     set pos [getPos]
  242.     set start [lineStart $pos]
  243.     set text [getText $start $pos]
  244.     
  245.     if {[string first "for" $text] != "-1"} {
  246.         set lefts 0
  247.         set rights 0
  248.         set len [string length $text]
  249.         for {set i 0} {$i < $len} {incr i} {
  250.             case [string index $text $i] in {
  251.                 "("    { incr lefts }
  252.                 ")"    { incr rights }
  253.             }
  254.         }
  255.         if {$lefts != $rights} {
  256.             insertText ";"
  257.             return
  258.         }
  259.     }
  260.     
  261.     insertText ";\r" [htmlGetIndent $pos]
  262. }
  263.  
  264. #===============================================================================
  265. # Building tags, including element attributes
  266. #===============================================================================
  267.  
  268. # A couple of functions to get element variables from the right package.
  269. proc htmlGetSomeAttrs {item type num1} {
  270.     global htmlElem${type}$num1
  271.     if {[catch {set atts [set htmlElem${type}${num1}($item)]}]} { 
  272.         set atts {} 
  273.     }
  274.     return $atts
  275. }    
  276.  
  277. proc htmlGetRequired {item} {
  278.     return [htmlGetSomeAttrs $item AttrRequired 1]
  279. }
  280.  
  281. proc htmlGetOptional {item {all 0}} {
  282.     set attrs [concat [htmlGetSomeAttrs $item AttrOptional 1] [htmlGetSomeAttrs $item EventHandler 1]]
  283.     if {$all} {return $attrs}
  284.     global HTMLmodeVars htmlHideDeprecated htmlHideExtensions
  285.     set hidden [htmlGetHidden $item]
  286.     set exp1 "\[ \n\r\t]+([join $HTMLmodeVars(alwaysaskforAttributes) |])"
  287.     regsub -all $exp1 " $hidden" " " hidden
  288.     set exp "\[ \n\r\t]+([join $HTMLmodeVars(dontaskforAttributes) |])"
  289.     regsub -all $exp " $hidden" " " hidden
  290.     set exp "\[ \n\r\t]+([join $hidden |])"
  291.     regsub -all $exp " $attrs" " " attrs
  292.     set exp "\[ \n\r\t]+([join $HTMLmodeVars(neveraskforAttributes) |])"
  293.     regsub -all $exp " $attrs" " " attrs
  294.     if {$htmlHideDeprecated || $HTMLmodeVars(hideDeprecated)} {
  295.         set exp "\[ \n\r\t]+([join [concat [htmlGetExtensions $item] [htmlGetDeprecated $item]] |])"
  296.         regsub -all $exp " $attrs" " " attrs
  297.         if {$htmlHideDeprecated} {regsub "TARGET=" $attrs " " attrs}
  298.     } elseif {$htmlHideExtensions || $HTMLmodeVars(hideExtensions)} {
  299.         set exp "\[ \n\r\t]+([join [htmlGetExtensions $item] |])"
  300.         regsub -all $exp " $attrs" " " attrs
  301.     }
  302.     return $attrs
  303. }
  304.  
  305. proc htmlGetNumber {item} {
  306.     return [htmlGetSomeAttrs $item AttrNumber 1]
  307. }
  308.  
  309.  
  310. proc htmlGetChoices {item} {
  311.     return [htmlGetSomeAttrs $item AttrChoices 1]
  312. }
  313.  
  314. proc htmlGetUsed {item {reqatts ""} {optatts ""} {arr 0}} {
  315.     global HTMLmodeVars
  316.     set useatts [htmlGetSomeAttrs $item AttrUsed ""]
  317.     if {$arr} {return $useatts}
  318.     if {$reqatts == ""} {set reqatts [htmlGetRequired $item]}
  319.     if {$optatts == ""} {set optatts [htmlGetOptional $item]}
  320.     set exp "\[ \n\r\t]+([join [concat $useatts $HTMLmodeVars(alwaysaskforAttributes)] |])"
  321.     regsub -all $exp " $optatts" " " opt1
  322.     set exp "\[ \n\r\t]+([join $opt1 |])"
  323.     regsub -all $exp " $optatts" " " useatts
  324.     return [concat $reqatts $useatts]
  325. }
  326.  
  327. proc htmlGetHidden {item} {
  328.     return [htmlGetSomeAttrs $item AttrHidden ""]
  329. }
  330.  
  331. proc htmlGetExtensions {item} {
  332.     return [htmlGetSomeAttrs $item Extension ""]
  333. }
  334.  
  335. proc htmlGetDeprecated {item} {
  336.     return [htmlGetSomeAttrs $item Deprecated ""]
  337. }
  338.  
  339. proc htmlOpenElem {elem {used ""} {pos -1}} {
  340.     global HTMLmodeVars 
  341.     if {$HTMLmodeVars(useBigWindows)} {
  342.         return [htmlOpenElemWindow $elem $used $pos]
  343.     } else {
  344.         return [htmlOpenElemStatusBar $elem $used $pos]
  345.     }
  346. }
  347.  
  348. # Opening or only tag of an element - include attributes
  349. # Big window with all attributes.
  350. # Return empty string if user clicks "Cancel".
  351.  
  352. proc htmlOpenElemWindow {elem used wrPos {values ""} {addNotUsed 0} {addHidden 0} {absPos ""}} {
  353.     global HTMLmodeVars  htmlColorName htmlElemEventHandler1
  354.     global  htmluserColors basicColors
  355.     global htmlURLAttr htmlColorAttr  htmlWindowAttr
  356.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  357.     
  358.     set URLs $HTMLmodeVars(URLs)
  359.     set Windows {_self _top _parent _blank}
  360.     if {[llength $HTMLmodeVars(windows)]} {append Windows " - " $HTMLmodeVars(windows)}
  361.     
  362. # put users colours first
  363.     set htmlColors [lsort [array names htmluserColors]]
  364.      append htmlColors " - " $basicColors
  365.  
  366.     if {![string length $used]} {set used $elem}
  367.     set elem [string toupper $elem]
  368.     set used [string toupper $used]
  369.     
  370.     # get variables for the element
  371.     set reqatts [htmlGetRequired $used]
  372.     set numatts [htmlGetNumber $used]
  373.     set eventatts [htmlGetSomeAttrs $used EventHandler 1]
  374.     set optatts [htmlGetOptional $used]
  375.     set choiceatts [htmlGetChoices $used]
  376.     set notUsedAtts ""
  377.     set allatts [htmlGetUsed $used $reqatts $optatts]
  378.     regsub -all "\[ \n\r\t]+([join $allatts |])" " $optatts" " " notUsedAtts
  379.     if {$addNotUsed} {
  380.         append allatts " $notUsedAtts"
  381.         set notUsedAtts ""
  382.     }
  383.     if {$addHidden} {
  384.         regsub -all "\[ \n\r\t]+([join $optatts |])" " [htmlGetOptional $used 1]" " " hiddenAtts
  385.         append allatts " $hiddenAtts"
  386.     }
  387.  
  388.     # if there are attributes to ask about, do so
  389.  
  390.     set text "<"
  391.     append text  [htmlSetCase $elem]
  392.     if {![llength $allatts]} {return "$text>"}
  393.  
  394.     set maxHeight [expr [lindex [getMainDevice] 3] - 115]
  395.     set thisPage "Page 1"
  396.  
  397.     set widthIndex -1
  398.     set heightIndex -1
  399.     if {$absPos == ""} {set absPos [getPos]}
  400.     # build window with attributes 
  401.     set invalidInput 1
  402.     while {$invalidInput} {
  403.         # wrapping
  404.         set htmlWrapPos [expr $wrPos == -1 ? [posX [getPos]] : $wrPos]
  405.         incr htmlWrapPos [expr [string length $text] + 1]
  406.         while {1} {
  407.             if {$used == "LI IN UL" || $used == "LI IN OL"} {
  408.                 set pr LI
  409.             } else {
  410.                 set pr $used
  411.             }
  412.             set box1 "-t {Attributes for $pr} 120 10 450 25"
  413.             set box2 "-t {Attributes for $pr} 120 10 450 25"
  414.             set box3 "-t {Attributes for $pr} 120 10 450 25"
  415.             set page 1
  416.             set attrtypes {}
  417.             set fileIndex ""
  418.             set colorIndex ""
  419.             set wpos 10
  420.             if {[string length $reqatts]} {
  421.                 lappend box$page -p 120 30 270 31 -t {Required attributes} 10 35 200 50
  422.                 set hpos 60
  423.             } else {
  424.                 set hpos 30
  425.             }
  426.             set attrIndex 2
  427.             for {set i 0} {$i < [llength $allatts]} {incr i} {
  428.                 set attr [lindex $allatts $i]
  429.                 if {$i == [llength $reqatts]} {
  430.                     if {$wpos > 20} { incr hpos 20 }
  431.                     lappend box$page -p 120 $hpos 270 [expr $hpos + 1] \
  432.                     -t {Optional attributes} 10 [expr $hpos + 5] 200 [expr $hpos + 20]
  433.                     set wpos 10
  434.                     incr hpos 30
  435.                 }
  436.                 set a2 [string trimright $attr =]
  437.                 if {[string index $attr [expr [string length $attr] - 1]] != "="}  { 
  438.                     # Flag
  439.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  440.                         incr page
  441.                         set hpos 40
  442.                     }
  443.                     lappend box$page -c $attr [lindex $values $attrIndex] $wpos $hpos [expr $wpos + 100] [expr $hpos + 15]
  444.                     incr attrIndex 
  445.                     if {$wpos > 20} { 
  446.                         incr hpos 25
  447.                         set wpos 10
  448.                     } else {
  449.                         set wpos 230
  450.                     }
  451.                     lappend attrtypes flag
  452.                 } elseif {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${used}!=$a2"] < 0) || \
  453.                 [lsearch -exact $htmlSpecURL "${used}=$a2"] >= 0} { 
  454.                     # URL
  455.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}
  456.                     if {[expr $hpos + 45] > $maxHeight && $page < 3} {
  457.                         incr page
  458.                         set hpos 40
  459.                     }
  460.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  461.                     -e [lindex $values $attrIndex] 120 $hpos 450 [expr $hpos + 15] \
  462.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] $URLs] \
  463.                     120 [expr $hpos + 25] 450 [expr $hpos + 35] \
  464.                     -b "File…" 10 [expr $hpos + 20] 70 [expr $hpos + 40]
  465.                     incr attrIndex 3
  466.                     incr hpos 50
  467.                     lappend attrtypes url
  468.                     lappend fileIndex [expr $attrIndex - 1]
  469.                 } elseif {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${used}!=$a2"] < 0) || \
  470.                 [lsearch -exact $htmlSpecColor "${used}=$a2"] >= 0} { 
  471.                     # Color attribute
  472.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  473.                     if {[expr $hpos + 25] > $maxHeight && $page < 3} {
  474.                         incr page
  475.                         set hpos 40
  476.                     }
  477.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  478.                     -e [lindex $values $attrIndex] 120 $hpos 190 [expr $hpos + 15] \
  479.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] $htmlColors] \
  480.                     200 $hpos 340 [expr $hpos + 15] \
  481.                     -b "New Color…" 350 $hpos 450 [expr $hpos + 20]
  482.                     incr attrIndex 3
  483.                     incr hpos 30
  484.                     lappend attrtypes color
  485.                     lappend colorIndex [expr $attrIndex - 1]
  486.                 } elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${used}!=$a2"] < 0) || \
  487.                 [lsearch -exact $htmlSpecWindow "${used}=$a2"] >= 0} { 
  488.                     # Window attribute
  489.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  490.                     if {[expr $hpos + 25] > $maxHeight && $page < 3} {
  491.                         incr page
  492.                         set hpos 40
  493.                     }
  494.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  495.                     -e [lindex $values $attrIndex] 120 $hpos 240 [expr $hpos + 15] \
  496.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] \
  497.                     $Windows] \
  498.                     250 $hpos 440 [expr $hpos + 15]
  499.                     incr attrIndex 2
  500.                     incr hpos 30
  501.                     lappend attrtypes window
  502.                 } elseif {[lsearch $numatts "${attr}*"] >= 0} { 
  503.                     # Number
  504.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  505.                         incr page
  506.                         set hpos 40
  507.                     }
  508.                     if {$attr == "WIDTH="} {set widthIndex $attrIndex}
  509.                     if {$attr == "HEIGHT="} {set heightIndex $attrIndex}
  510.                     lappend box$page -t $attr $wpos $hpos [expr $wpos + 100] [expr $hpos + 15] \
  511.                     -e [lindex $values $attrIndex] [expr $wpos + 110] $hpos [expr $wpos + 150] [expr $hpos + 15]
  512.                     incr attrIndex 
  513.                     if {$wpos > 20} { 
  514.                         incr hpos 25
  515.                         set wpos 10
  516.                     } else {
  517.                         set wpos 230
  518.                     }
  519.                     lappend attrtypes number
  520.                 } elseif {[lsearch $choiceatts "${attr}*"] >= 0} { 
  521.                     # Choices
  522.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  523.                         incr page
  524.                         set hpos 40
  525.                     }
  526.                     set matches {}
  527.                     foreach w $choiceatts {
  528.                         if {[string match "${attr}*" $w]} {
  529.                             lappend matches  [string range $w [string length $attr] end]
  530.                         }    
  531.                     }
  532.                     lappend box$page -t $attr $wpos $hpos [expr $wpos + 100] [expr $hpos + 15] \
  533.                     -m [concat [list [lindex $values $attrIndex] {No value}] $matches] \
  534.                     [expr $wpos + 110] $hpos [expr $wpos + 205] [expr $hpos + 15]
  535.                     incr attrIndex 
  536.                     if {$wpos > 20} { 
  537.                         incr hpos 25 
  538.                         set wpos 10
  539.                     } else {
  540.                         set wpos 230
  541.                     }    
  542.                     lappend attrtypes choices
  543.                 } else {
  544.                     # Any other
  545.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  546.                     if {[expr $hpos + 20] > $maxHeight && $page < 3} {
  547.                         incr page
  548.                         set hpos 40
  549.                     }
  550.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  551.                     -e [lindex $values $attrIndex] 120 $hpos 450 [expr $hpos + 15] 
  552.                     incr attrIndex
  553.                     incr hpos 25
  554.                     lappend attrtypes any
  555.                 }
  556.             }
  557.             if {$wpos > 20} { incr hpos 25 }
  558.             
  559.             if {$page == 1} {
  560.                 set box $box1
  561.             } elseif {$page == 2} {
  562.                 set hpos $maxHeight
  563.                 set box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2"
  564.             } elseif {$page == 3} {
  565.                 set hpos $maxHeight
  566.                 set box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\} \{Page 3\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2 -n \{Page 3\} $box3"
  567.             }
  568.             # Add More button if hidden attrs
  569.             set moreButton 0
  570.             if {[llength $notUsedAtts]} {
  571.                 set box " -b More… 200 [expr $hpos + 20] 265 [expr $hpos + 40] $box"
  572.                 set moreButton 1
  573.             }
  574.             set values [eval [concat dialog -w 460 -h [expr $hpos + 50] \
  575.             -b OK 20 [expr $hpos + 20]  85 [expr $hpos + 40] \
  576.             -b Cancel 110 [expr $hpos + 20] 175 [expr $hpos + 40] $box]]
  577.             
  578.             # More button clicked?
  579.             if {$moreButton && [lindex $values 2]} {
  580.                 append allatts " $notUsedAtts"
  581.                 set notUsedAtts ""
  582.             }
  583.             # If more button...
  584.             if {$moreButton} {
  585.                 set values [lreplace $values 2 2]
  586.             }
  587.             # If two pages...
  588.             if {$page > 1} {
  589.                 set thisPage [lindex $values 2]
  590.                 set values [lreplace $values 2 2]
  591.             }
  592.             # OK button clicked?
  593.             if {[lindex $values 0] } { break }
  594.             # Cancel button clicked?
  595.             if {[lindex $values 1] } { return}
  596.             # File button clicked?
  597.             foreach fl $fileIndex {
  598.                 if {[lindex $values $fl] && [string length [set newFile [htmlGetFile]]]} {
  599.                     set URLs $HTMLmodeVars(URLs)
  600.                     set values [lreplace $values [expr $fl - 1] [expr $fl - 1] [lindex $newFile 0]]
  601.                     if {$used == "IMG" && $fl == 4 && [llength [set widhei [lindex $newFile 1]]]} {
  602.                         if {$widthIndex >= 0} {set values [lreplace $values $widthIndex $widthIndex [lindex $widhei 0]]}
  603.                         if {$heightIndex >= 0} {set values [lreplace $values $heightIndex $heightIndex [lindex $widhei 1]]}
  604.                     }
  605.                 }
  606.             }
  607.             # Color button clicked?
  608.             foreach cl $colorIndex {
  609.                 if {[lindex $values $cl] && [string length [set newcolor [htmlAddNewColor]]]} {
  610.                     set htmlColors [concat [list $newcolor] $htmlColors]
  611.                     set values [lreplace $values [expr $cl - 1] [expr $cl - 1] "$newcolor"]
  612.                 }
  613.             }
  614.         }
  615.         
  616.  
  617.         # put everything together
  618.         set attrtext ""
  619.         set errtext ""
  620.  
  621.         set j 2
  622.         for {set i 0} {$i < [llength $attrtypes]} {incr i} {
  623.             set attr [lindex $allatts $i]                
  624.             switch [lindex $attrtypes $i] {
  625.                 url {
  626.                     set texturl [string trim [lindex $values $j]]
  627.                     set menuurl [lindex $values [expr $j + 1]]
  628.                     if {[string length $texturl]} {        
  629.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes [htmlURLescape2 $texturl]]"]
  630.                         htmlAddToCache URLs $texturl
  631.                     } elseif {$menuurl != "No value"} {
  632.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes [htmlURLescape2 $menuurl]]"] 
  633.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  634.                         lappend errtext "$attr required."
  635.                     }
  636.                     incr j 3
  637.                 }
  638.                 color {
  639.                     set colortxt [lindex $values $j]
  640.                     set colorval [lindex $values [expr $j + 1]]
  641.                     if {[string length $colortxt]} {
  642.                         set col [htmlCheckColorNumber $colortxt]
  643.                                  if {$col == 0} {
  644.                                      lappend errtext "$attr: $colortxt is not a valid color number."
  645.                         } else {    
  646.                             append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $col]"]
  647.                         }
  648.                     } elseif {$colorval != "No value"} {
  649.                         # Users own color?
  650.                         if {[info exists htmluserColors($colorval)]} {
  651.                             set colornum $htmluserColors($colorval)
  652.                         }
  653.                         # Predefined color?
  654.                         if {[info exists htmlColorName($colorval)]} {
  655.                             set colornum $htmlColorName($colorval)
  656.                         }
  657.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $colornum]"]
  658.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  659.                         lappend errtext "$attr required."
  660.                     }
  661.                     incr j 3
  662.                 }
  663.                 window {
  664.                     set textwin [string trim [lindex $values $j]]
  665.                     set menuwin [lindex $values [expr $j + 1]]
  666.                     if {[string length $textwin]} {        
  667.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $textwin]"]
  668.                         htmlAddToCache windows $textwin
  669.                     } elseif {$menuwin != "No value"} {
  670.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $menuwin]"]
  671.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  672.                         lappend errtext "$attr required."
  673.                     }
  674.                     incr j 2
  675.                 }
  676.                 number {
  677.                     set numval [string trim [lindex $values $j]]
  678.                     if {[string length $numval]} {
  679.                         if {[htmlCheckAttrNumber $used $attr $numval] == 1} {        
  680.                             append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $numval]"]
  681.                         } else {
  682.                             lappend errtext "$attr: [htmlCheckAttrNumber $used $attr $numval]"
  683.                         }
  684.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  685.                         lappend errtext "$attr required."
  686.                     }
  687.                     incr j
  688.                 }
  689.                 choices {
  690.                     set choiceval [lindex $values $j]
  691.                     if {$choiceval != "No value"} {        
  692.                         set qchoice [htmlAddQuotes $choiceval]
  693.                         if {($used != "LI IN OL" && $used != "OL") || $attr != "TYPE="} {
  694.                             set qchoice [htmlSetCase $qchoice]
  695.                         }
  696.                         append attrtext [htmlWrapTag "[htmlSetCase $attr]$qchoice"]
  697.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  698.                         lappend errtext "$attr required."
  699.                     }
  700.                     incr j
  701.                 }
  702.                 any {
  703.                     set anyval [lindex $values $j]
  704.                     # Trim only if it's only spaces.
  705.                     if {[string trim $anyval] == ""} {set anyval ""}
  706.                     if {[string length $anyval]} {
  707.                         htmlOpenExtraThings $used $attr $anyval
  708.                         if {[lsearch -exact $eventatts $attr] < 0} {
  709.                             set attr [htmlSetCase $attr]
  710.                         }
  711.                         append attrtext [htmlWrapTag "$attr[htmlAddQuotes $anyval]"]
  712.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  713.                         lappend errtext "$attr required."
  714.                     }
  715.                     incr j
  716.                 }
  717.                 flag {
  718.                     set flagval [lindex $values $j]
  719.                     if {$flagval} {        
  720.                         append attrtext [htmlWrapTag [htmlSetCase $attr]]
  721.                     }
  722.                     incr j
  723.                 }
  724.             }
  725.         }    
  726.         # If everything is OK, add the attribute text to text.
  727.         if {![llength $errtext]} {
  728.             append text $attrtext
  729.             set invalidInput 0
  730.         } else {
  731.             # Put up alert with the error text.
  732.             htmlErrorWindow "Invalid input for $used" $errtext
  733.         }
  734.         # Some tests that input is ok.
  735.         if {!$invalidInput} {set invalidInput [htmlFontBaseTest $text alertnote]}
  736.         if {!$invalidInput && $elem == "A" && [set invalidInput [htmlATest $text alertnote]]} {
  737.             set text "<[htmlSetCase A]"
  738.         }
  739.         if {!$invalidInput && $elem == "FRAMESET" && [set invalidInput [htmlFramesetTest $text alertnote]]} {
  740.             set text "<[htmlSetCase FRAMESET]"
  741.         }
  742.         if {!$invalidInput && $elem == "SPACER" && [set invalidInput [htmlSpacerTest $text alertnote]]} {
  743.             set text "<[htmlSetCase SPACER]"
  744.         }
  745.         if {!$invalidInput && $elem == "AREA" && [set invalidInput [htmlAreaTest $text alertnote]]} {
  746.             set text "<[htmlSetCase AREA]"
  747.         }
  748.     }
  749.     
  750.     if {[string length $text] } {append text ">"}
  751.     
  752.     return ${text}
  753. }
  754.  
  755. proc htmlWrapTag {toadd} {
  756.     global fillColumn HTMLmodeVars
  757.     upvar htmlWrapPos wrpos absPos ap
  758.     if {!$HTMLmodeVars(wordWrap)} {return " $toadd"}
  759.     incr wrpos [string length $toadd]
  760.     if {$wrpos > $fillColumn} {
  761.         set ind [htmlGetIndent $ap]
  762.         set wrpos [string length "$ind$toadd"]
  763.         return "\r$ind$toadd"
  764.     } else {
  765.         return " $toadd"
  766.     }
  767. }
  768.  
  769. # these two require at least one of several optional attributes
  770. proc htmlFontBaseTest {text cmd} {
  771.     if {[string toupper $text] == "<FONT" || [string toupper $text] == "<BASEFONT" ||
  772.     [string toupper $text] == "<BASE" || [string toupper $text] == "<SPAN"} {  
  773.         eval {$cmd "At least one of the attributes is required."}
  774.         return 1
  775.     }
  776.     return 0
  777. }
  778.  
  779. # HREF or NAME must be used for A.
  780. proc htmlATest {text cmd} {
  781.     if {![regexp -nocase {href=} $text] && ![regexp -nocase {name=} $text]} {
  782.         eval {$cmd "At least one of the attributes HREF and NAME must be used."}
  783.         return 1
  784.     }
  785.     return 0
  786. }
  787.  
  788. # ROWS or COLS must be used for FRAMESET
  789. proc htmlFramesetTest {text cmd} {
  790.     if {![regexp -nocase {rows=} $text] && ![regexp -nocase {cols=} $text]} {
  791.         eval {$cmd "At least one of the attributes ROWS and COLS must be used."}
  792.         return 1
  793.     }
  794.     return 0
  795. }
  796.  
  797. # Some checks for SPACER.
  798. proc htmlSpacerTest {text cmd} {
  799.         set horver [regexp -nocase {type=\"(horizontal|vertical)\"} $text]
  800.         set wh [regexp -nocase {width=|height=} $text]
  801.         set sz [regexp -nocase {size=} $text]
  802.         set al [regexp -nocase {align=} $text]
  803.         set invalidInput 1
  804.         if {$horver && ($wh || $al)} {
  805.             eval {$cmd "WIDTH, HEIGHT and ALIGN should only be used when TYPE=BLOCK."}
  806.         } elseif {!$horver && $sz} {
  807.             eval {$cmd "SIZE should only be used when TYPE=HORIZONTAL or VERTICAL."}
  808.         } elseif {$horver && !$sz} {
  809.             eval {$cmd "SIZE is required when TYPE=HORIZONTAL or VERTICAL."}
  810.         } elseif {!$horver && !$wh} {
  811.             eval {$cmd "WIDTH or HEIGHT is required when TYPE=BLOCK."}
  812.         } else {
  813.             set invalidInput 0
  814.         }
  815.         return $invalidInput
  816. }
  817.  
  818. # For AREA, either HREF or NOHREF must be used, but not both.
  819. proc htmlAreaTest {text cmd} {
  820.     set hasHref [regexp -nocase {href=} $text]
  821.     set hasNohref [regexp -nocase {nohref} $text]
  822.     set hasCoords [regexp -nocase {coords=} $text]
  823.     set shapeDefault [regexp -nocase {shape=\"default\"} $text]
  824.     set invalidInput 0
  825.     if {($hasHref && $hasNohref) || (!$hasHref && !$hasNohref)} {
  826.         eval {$cmd "One of the attributes HREF and NOHREF must be used, but not both."}
  827.         set invalidInput 1
  828.     } elseif {!$hasCoords && !$shapeDefault} {
  829.         eval {$cmd "COORDS= is required if SHAPE≠DEFAULT"}
  830.         set invalidInput 1
  831.     }
  832.     return $invalidInput
  833. }
  834.  
  835. # Adds a NAME= value to cache.
  836. proc htmlOpenExtraThings {elem attr val} {
  837.     if {[lsearch -exact {A MAP} $elem] >= 0 && $attr == "NAME="} {
  838.         htmlAddToCache URLs "#$val"
  839.     }
  840.     if {$elem == "FRAME" && $attr == "NAME="} {
  841.         htmlAddToCache windows $val
  842.     }
  843. }
  844.  
  845.  
  846. # Check if a input is a valid number for the element attribute.
  847. # Returns 1 if it is, otherwise returns an error message.
  848. proc htmlCheckAttrNumber {item attr number} {
  849.     
  850.     set attrNumbers [htmlGetNumber $item]
  851.     set numind [lsearch $attrNumbers "${attr}*"]
  852.     set numstr [string range [lindex $attrNumbers $numind] [string length $attr] end]
  853.     regexp {^[-i0-9]+} $numstr minvalue
  854.     set numstr [string range $numstr [expr [string length $minvalue] + 1] end]
  855.     regexp {^[-i0-9]+} $numstr maxvalue
  856.     set procent [string range $numstr [expr [string length $numstr] - 1] end]
  857.     if {$procent == "%"} {
  858.         set procerr " or percentage"
  859.     } else {
  860.         set procerr ""
  861.     }
  862.     if {$minvalue == "-i"} {
  863.         set errtext "An integer"
  864.     } elseif {$maxvalue == "i"} {
  865.         set errtext "A number $minvalue or greater"
  866.     } else {
  867.         set errtext "A number in the range $minvalue to $maxvalue"
  868.     }
  869.     if {$item == "FONT"} { append errtext " or -6 to +6"}
  870.     append errtext  "$procerr expected." 
  871.     # Is percent allowed?
  872.     if {[string index $number [expr [string length $number] - 1]] == "%" } {
  873.         set number [string range $number 0 [expr [string length $number] - 2]]
  874.         if {$procent != "%"} {return $errtext}
  875.     }
  876.     # FONT can take values -6 - +6. Special case.
  877.     if {$item == "FONT" && [regexp {^(\+|-)[1-6]$} $number]} { return 1}
  878.     # Is input a number?
  879.     if {![regexp {^-?[0-9]+$} $number]} {return $errtext}
  880.     # Is input in the valid range?
  881.     if {( $maxvalue != "i" && $number > $maxvalue ) || ( $minvalue != "-i" && $number < $minvalue ) } {
  882.         return $errtext
  883.     }    
  884.     return 1 
  885. }
  886.  
  887.  
  888. # Add quotes to attribute
  889. proc htmlAddQuotes {v} {
  890.  
  891.     if {[string range $v 0 0] != "\""} {set v  "\"$v"}
  892.      set vlen [expr [string length $v] - 1]
  893.     if {[string range $v $vlen $vlen] !="\""} {append v "\""}
  894.     return $v
  895. }
  896.  
  897.  
  898. # Splits an attribute into its name and value and remove quotes.
  899. proc htmlRemoveQuotes {attrStr} {
  900.     # Is it a flag?
  901.     if {![string match "*=*" $attrStr]} {return [string toupper $attrStr]}
  902.     
  903.     set attr [string range $attrStr 0 [string first "=" $attrStr]]
  904.     # Get the attribute value.
  905.     set attrVal [string range $attrStr [expr [string first "=" $attrStr] + 1] end]
  906.     
  907.     return [list $attr [string trim $attrVal \"]]
  908. }
  909.  
  910. # Returns a list of the attributes not used for the tag at the current position.
  911. proc htmlGetAttributes {} {
  912.     global htmlElemKeyBinding
  913.     set pos [getPos]
  914.     if {[catch {search -s -f 0 -r 1 -m 0 {<[^<>]+>} $pos} res] || [lindex $res 1] < $pos} {
  915.         message "Current position is not at a tag."
  916.         return
  917.     }
  918.     set tag [string trim [lindex [set all [string toupper [eval getText $res]]] 0] "<>"]
  919.     if {$tag == "LI"} {
  920.         set ltype [htmlFindList]
  921.         if {$ltype == "UL"} {
  922.             set tag "LI IN UL"
  923.         } elseif {$ltype == "OL"} {
  924.             set tag "LI IN OL"
  925.         }            
  926.     }
  927.     # All INPUT elements are defined differently. Must extract TYPE.
  928.     if {$tag == "INPUT"} {
  929.         if {![regexp -nocase { TYPE=\"?([^ \t\r\"<>]+)\"?} $all dum tag]} {
  930.             message "INPUT element without a TYPE attribute."
  931.             return
  932.         }
  933.         set tag [string toupper $tag]
  934.         if {![info exists htmlElemKeyBinding($tag)]} {set tag "INPUT TYPE=$tag"}
  935.     }
  936.     set ret ""
  937.     foreach a [concat [htmlGetRequired $tag] [htmlGetOptional $tag]] {
  938.         set exp "\[ \t\r\n\]+${a}"
  939.         if {![regexp -nocase $exp $all]} {
  940.             lappend ret $a
  941.         }
  942.     }
  943.     if {$ret == ""} {message "No attributes."}
  944.     return $ret
  945. }
  946.  
  947. # Inserts an attribute in a tag at the current position.
  948. proc htmlInsertAttributes {{attrList ""}} {
  949.     global HTMLmodeVars fillColumn elecStopMarker
  950.     set useMarks $HTMLmodeVars(useTabMarks)
  951.     if {$attrList == "" && ([set l [htmlGetAttributes]] == "" ||
  952.     [catch {listpick -p "Select attributes" -l $l} attrList] || $attrList == "") } {return}
  953.     foreach attr $attrList {
  954.         set epos [expr [lindex [search -s -f 0 -r 1 -m 0 {<[^<>]+>} [getPos]] 1] - 1]
  955.         if {[expr [posX $epos] + [string length $attr]] > $fillColumn && $HTMLmodeVars(wordWrap)} {
  956.             set text "\r[htmlGetIndent $epos]"
  957.         } else {
  958.             set text " "
  959.         }
  960.         append text $attr
  961.         if {[string match "*=" $attr]} {
  962.             append text "\"\""
  963.             if {$useMarks} {append text $elecStopMarker}        
  964.         }
  965.         set x [expr $epos - 3]
  966.         if {[string match "*$elecStopMarker" [set etxt [getText $x $epos]]]} {
  967.             set p [expr $x + 1]
  968.             if {$useMarks} {
  969.                 if {[string match "*=" $attr]} {
  970.                     set text [string range $text 0 [expr [string length $text] - 3]]$elecStopMarker\"$elecStopMarker
  971.                 } else {
  972.                     append text $elecStopMarker
  973.                 }
  974.             }
  975.             replaceText [expr $p + 1] $epos $text
  976.         } else {
  977.             goto $epos
  978.             insertText $text
  979.             if {[regexp {=} $text]} {goto [expr + [getPos] - 1 - $useMarks]}
  980.         }
  981.     }
  982. }
  983.  
  984. #===============================================================================
  985. # Element build routines
  986. #===============================================================================
  987.  
  988. # Closing tag of an element
  989. proc htmlCloseElem {theElem} {
  990.     return "</[htmlSetCase $theElem]>"
  991. }
  992.  
  993.  
  994. proc htmlTag {str} {
  995.     global htmlElemProc
  996.     set elem [lindex $str 1]
  997.     if {[htmlIsInContainer STYLE]} {
  998.         if {[lindex $str 0] == "htmlBuildInputElem"} {set elem INPUT}
  999.         replaceText [getPos] [selEnd] $elem
  1000.     } elseif {[info exists htmlElemProc($elem)]} {
  1001.         eval $htmlElemProc($elem)
  1002.     } else {
  1003.         eval $str
  1004.     }
  1005. }
  1006.  
  1007. # Build elements with only a opening tag.
  1008. proc htmlBuildOpening {ftype {begCR 0} {endCR 0} {attr ""}} {
  1009.     set text1 ""
  1010.     set indent [htmlGetIndent [getPos]]
  1011.     if {$begCR} { 
  1012.         set text1 [htmlOpenCR $indent]
  1013.     }
  1014.     set text [htmlOpenElem $ftype $attr]
  1015.     if {![string length $text]} {return}
  1016.     if {$endCR} {
  1017.         append text [htmlCloseCR $indent]
  1018.     }
  1019.     insertText $text1 $text
  1020. }
  1021.  
  1022.     
  1023. # This is used for almost all containers
  1024. proc htmlBuildElem {ftype {attr ""}} {
  1025.     global HTMLmodeVars htmlCurSel htmlIsSel elecStopMarker
  1026.  
  1027.     if {![string length [set text [htmlOpenElem $ftype $attr]]]} {return}
  1028.     htmlGetSel
  1029.     append text $htmlCurSel
  1030.     set currpos [expr [getPos] + [string length $text]]
  1031.     append text [htmlCloseElem $ftype]
  1032.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text $elecStopMarker}
  1033.     if {$htmlIsSel} {
  1034.         replaceText [getPos] [selEnd] $text
  1035.     } else {
  1036.         insertText $text
  1037.         goto $currpos
  1038.     }
  1039. }
  1040.  
  1041. # This is used for elements that should be surrounded by newlines
  1042. proc htmlBuildCRElem {ftype {extrablankline 0} {attr ""}} {
  1043.     global htmlCurSel htmlIsSel HTMLmodeVars elecStopMarker
  1044.  
  1045.     if {![string length [set text2 [htmlOpenElem $ftype $attr 0]]]} {return}
  1046.     set indent [htmlFindNextIndent]
  1047.     set text [htmlOpenCR $indent $extrablankline]
  1048.     append text $text2
  1049.     htmlGetSel
  1050.     append text $htmlCurSel
  1051.     set currpos [expr [getPos] + [string length $text]]
  1052.     append text [htmlCloseElem $ftype]
  1053.     if {$extrablankline} {
  1054.         set cr2 [htmlCloseCR2 $indent [selEnd]]
  1055.     } else {
  1056.         set cr2 [htmlCloseCR $indent]
  1057.     }
  1058.     append text $cr2
  1059.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text $elecStopMarker}
  1060.     if {$htmlIsSel} { deleteSelection }
  1061.     insertText $text
  1062.     if {!$htmlIsSel} {
  1063.         goto $currpos
  1064.     }
  1065. }
  1066.  
  1067. # This is used for elements that should be surrounded by empty lines
  1068. proc htmlBuildCR2Elem {ftype {attr ""}} {
  1069.     global HTMLmodeVars htmlCurSel htmlIsSel elecStopMarker indentationAmount
  1070.     
  1071.     htmlGetSel
  1072. # Check if user has skipped an attribute which can't be skipped.
  1073.     if {![string length [set text2 [htmlOpenElem $ftype $attr 0]]]} {return}
  1074.     set indent [htmlFindNextIndent]
  1075.     set text [htmlOpenCR $indent 1]
  1076.     append text $text2
  1077.     if {[info exists HTMLmodeVars(indent${ftype})] && $HTMLmodeVars(indent${ftype})} {
  1078.         set exindent [text::maxSpaceForm [text::Tab]]
  1079.         htmlIndentChunk htmlCurSel
  1080.     } else {
  1081.         set exindent ""
  1082.     }
  1083.     if {$htmlIsSel || ($ftype != "SCRIPT" && $ftype != "STYLE")} {
  1084.         append text "\r" [text::minSpaceForm "${indent}${exindent}"] $htmlCurSel
  1085.     } else {
  1086.         append text "\r${indent}<!-- /* Hide content from old browsers */\r${indent}"
  1087.     }
  1088.     set currpos [expr [getPos] + [string length $text]]
  1089.     append text \r$indent
  1090.     set pre(SCRIPT) "//"; set pre(STYLE) "/*"; set post(SCRIPT) ""; set post(STYLE) "*/"
  1091.     if {!$htmlIsSel && ($ftype == "SCRIPT" || $ftype == "STYLE")} {append text "$pre($ftype) end hiding content from old browsers $post($ftype) -->\r$indent"}
  1092.     append text [htmlCloseElem $ftype]
  1093.     append text [htmlCloseCR2 $indent [selEnd]]
  1094.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text $elecStopMarker}
  1095.     if {$htmlIsSel} { deleteSelection }
  1096.     insertText $text
  1097.     if {!$htmlIsSel}    {
  1098.         goto $currpos
  1099.     }
  1100. }
  1101.  
  1102. # Determines which list the current position is inside.
  1103. proc htmlFindList {} {    
  1104.     set listType ""
  1105.     foreach l [list UL OL DIR MENU] {
  1106.         set ex "<${l}(\[ \\t\\r\]+\[^>\]*>|>)"
  1107.         set listOpening [search -s -f 0 -i 1 -r 1 -m 0 -n $ex [getPos]]
  1108.         set ex2 </$l>
  1109.         set listClosing [search -s -f 0 -i 1 -r 1 -m 0 -n $ex2 [getPos]]
  1110.         # Search until a single list opening is found.
  1111.         while {[string length $listOpening] && [string length $listClosing] &&
  1112.         [lindex $listClosing 0] > [lindex $listOpening 0]} {
  1113.             set listOpening [search -s -f 0 -i 1 -r 1 -m 0 -n $ex [expr [lindex $listOpening 0] - 1]]
  1114.             set listClosing [search -s -f 0 -i 1 -r 1 -m 0 -n $ex2 [expr [lindex $listClosing 0] - 1]]
  1115.         }
  1116.         if {[string length $listOpening]} {
  1117.             lappend listType "$listOpening $l"
  1118.         }
  1119.     }
  1120.     set ltype [lindex [lindex $listType 0] 2]
  1121.     set lnum [lindex [lindex $listType 0] 0]
  1122.     for {set i 1} {$i < [llength $listType]} {incr i} {
  1123.         if {[lindex [lindex $listType $i] 0] > $lnum} {
  1124.             set ltype [lindex [lindex $listType $i] 2]
  1125.             set lnum [lindex [lindex $listType $i] 0]
  1126.         }
  1127.     }
  1128.     return $ltype
  1129. }
  1130.  
  1131.  
  1132. # Choose an item from Use Attributes menu.
  1133. proc htmlUseAttributes {} {
  1134.     global htmlElemAttrOptional1
  1135.     foreach a [array names htmlElemAttrOptional1] {
  1136.         if {[llength $htmlElemAttrOptional1($a)]} {lappend htmlPossibleToUse $a}
  1137.     }
  1138.     regsub " S " $htmlPossibleToUse " " htmlPossibleToUse
  1139.     if {![catch {listpick -p "Choose HTML element" [lsort $htmlPossibleToUse]} elem] &&
  1140.     $elem != ""} {htmlUseAttributes2 $elem}
  1141. }
  1142.  
  1143. # Customize list of attributes which get asked about
  1144. proc htmlUseAttributes2 {item} {
  1145.     global htmlElemAttrUsed htmlElemAttrHidden
  1146.     set reqattrs [htmlGetRequired $item]
  1147.     set optatts [htmlGetOptional $item 1]
  1148.     set used [htmlGetUsed $item $reqattrs $optatts 1]
  1149.     set extensions [htmlGetExtensions $item]
  1150.     set hidden [htmlGetHidden $item]
  1151.     htmlUseAttrsDialog "Attributes for $item" $optatts $extensions used hidden
  1152.     set htmlElemAttrUsed($item) $used
  1153.     set htmlElemAttrHidden($item) $hidden
  1154.     addArrDef htmlElemAttrUsed $item $used
  1155.     addArrDef htmlElemAttrHidden $item $hidden
  1156. }
  1157.  
  1158. proc htmlUseAttrsDialog {txt optatts extensions us hi {do ""} {isGlobal 0}} {
  1159.     global HTMLmodeVars modifiedModeVars
  1160.     upvar $us used $hi hidden
  1161.     if {$do != ""} {upvar $do dont}
  1162.     set hideExtensions $HTMLmodeVars(hideExtensions)
  1163.     set hideDeprecated $HTMLmodeVars(hideDeprecated)
  1164.     set alwaysask $HTMLmodeVars(alwaysaskforAttributes)
  1165.     set dontask $HTMLmodeVars(dontaskforAttributes)
  1166.     set neverask $HTMLmodeVars(neveraskforAttributes)
  1167.     set page 0
  1168.     set attrnumber [llength $optatts]
  1169.     set options {"Always ask about" "Don't ask about at first" "Never ask about"}
  1170.     set len 10
  1171.     if {$isGlobal} {
  1172.         set options "{Use individual settings} $options"
  1173.         set len 8
  1174.     }
  1175.     foreach a $optatts {
  1176.         if {[lsearch -exact $used $a] >= 0} {
  1177.             lappend uh $isGlobal
  1178.         } elseif {[lsearch -exact $hidden $a] >= 0} {
  1179.             lappend uh [expr 2 + $isGlobal]
  1180.         } elseif {!$isGlobal || [lsearch -exact $dont $a] >= 0} {
  1181.             lappend uh [expr 1 + $isGlobal]
  1182.         } else {
  1183.             lappend uh 0
  1184.         }
  1185.     }
  1186.     while {1} {
  1187.         set box "-t [list $txt] 100 10 370 25"
  1188.         if {!$isGlobal} {append box " -t {Global settings} 380 10 540 25"}
  1189.         set h 35
  1190.         if {$isGlobal && !$page} {
  1191.             append box " -c {Don't use extensions to HTML 4.0} $hideExtensions 10 $h 370 [expr $h + 20]"
  1192.             append box " -c {Don't use deprecated elements and attributes} $hideDeprecated 10 [expr $h + 25] 370 [expr $h + 45]"
  1193.             incr h 50
  1194.         }
  1195.         set n 0
  1196.         foreach a [lrange $optatts [expr $len * $page] [expr $len * $page + $len - 1]] {
  1197.             set m [lindex $uh [expr $len * $page + $n]]
  1198.             append box " -t [string trimright $a =] 10 $h 150 [expr $h + 20] -m {[lrange $options $m $m] $options} 160 $h 370 [expr $h + 20]"
  1199.             if {!$isGlobal} {
  1200.                 if {$hideExtensions && [lsearch -exact $extensions $a] >= 0 || [lsearch -exact $neverask $a] >= 0} {append box " -t {Never ask about} 380 $h 540 [expr $h + 20]"}
  1201.                 if {[lsearch -exact $dontask $a] >= 0} {append box " -t {Don't ask about at first} 380 $h 540 [expr $h + 20]"}
  1202.                 if {[lsearch -exact $alwaysask $a] >= 0} {append box " -t {Always ask about} 380 $h 540 [expr $h + 20]"}
  1203.             }
  1204.             incr h 25
  1205.             incr n
  1206.         }
  1207.         incr h 10
  1208.         set h1 [expr $h + 20]
  1209.         if {$page > 0} {append box " -b {<< Prev} 200 $h 265 $h1"}
  1210.         if {[expr $len * $page + $len] < $attrnumber} {append box " -b {Next >>} 290 $h 355 $h1"}
  1211.         set values [eval [concat dialog -w [expr $isGlobal ? 380 : 550] -h [expr $h + 30] -b OK 20 $h 85 $h1 -b Cancel 110 $h 175 $h1 $box]]
  1212.         if {$isGlobal && !$page} {
  1213.             set hideExtensions [lindex $values 2]
  1214.             set hideDeprecated [lindex $values 3]
  1215.             set values [lreplace $values 2 3]
  1216.         }
  1217.         if {[lindex $values 1]} {error "Cancel"}
  1218.         set uh1 ""
  1219.         foreach v [lrange $values 2 [expr $n + 1]] {
  1220.             lappend uh1 [lsearch -exact $options $v]
  1221.         }
  1222.         set uh [eval [concat lreplace [list $uh] [expr $len * $page] [expr $len * $page + $n - 1] $uh1]]
  1223.         if {[lindex $values 0]} {break}
  1224.         if {$page > 0 && [lindex $values [expr $n + 2]]} {
  1225.             incr page -1
  1226.         } else {
  1227.             incr page
  1228.         }
  1229.     }
  1230.     set used ""
  1231.     set hidden ""
  1232.     set dont ""
  1233.     for {set i 0} {$i < $attrnumber} {incr i} {
  1234.         if {[lindex $uh $i] == $isGlobal} {lappend used [lindex $optatts $i]}
  1235.         if {$isGlobal && [lindex $uh $i] == 2} {lappend dont [lindex $optatts $i]}
  1236.         if {[lindex $uh $i] == [expr 2 + $isGlobal]} {lappend hidden [lindex $optatts $i]}
  1237.     }
  1238.     foreach h {hideExtensions hideDeprecated} {
  1239.         if {[set $h] != $HTMLmodeVars($h)} {
  1240.             set HTMLmodeVars($h) [set $h]
  1241.             lappend modifiedModeVars [list $h HTMLmodeVars]
  1242.             htmlHide
  1243.         }
  1244.     }
  1245. }
  1246.  
  1247. #===============================================================================
  1248. # Indentation
  1249. #===============================================================================
  1250.  
  1251. proc HTML::indentLine {} {
  1252.     if {[htmlIsInContainer STYLE] || [htmlIsInContainer SCRIPT]} {text::genericIndent; return}
  1253.     if {[htmlIsInContainer PRE]} {return}
  1254.     
  1255.     set previndent [htmlFindIndent]
  1256.     set lend [expr [nextLineStart [getPos]] - 1]
  1257.     if {$lend < [getPos]} {set lend [maxPos]}
  1258.     set thisLine [string trimleft [getText [set lstart [lineStart [getPos]]] $lend ]]
  1259.     set thisIndent [htmlGetIndent [getPos]]
  1260.     if {$thisIndent != $previndent} {replaceText $lstart $lend "$previndent$thisLine"}
  1261.  
  1262. }
  1263.  
  1264. # Find the indentation the current line should have.
  1265. proc htmlFindIndent {{pos0 ""}} {
  1266.     global htmlIndentElements HTMLmodeVars
  1267.     set indent ""
  1268.     foreach i $htmlIndentElements {
  1269.         if {$HTMLmodeVars(indent$i)} {lappend indent $i}
  1270.     }
  1271.     # Find previous non-blank line.
  1272.     if {$pos0 == ""} {set pos0 [getPos]}
  1273.     set pos [expr [lineStart $pos0] - 1]
  1274.     while {$pos >= 0 && [regexp {^[ \t]*$} [getText [lineStart $pos] $pos]]} {
  1275.         set pos [expr [lineStart $pos] - 1]
  1276.     }
  1277.     set pos [expr $pos >= 0 ? $pos : 0]
  1278.     # Get indentation on that line.
  1279.     set previndent [htmlGetIndent $pos]
  1280.     # Find last tag on or before that line.
  1281.     if {[catch {search -s -f 0 -m 0 -r 1 {<([^<>]+)>} $pos} tag] || [lindex $tag 1] < [lineStart $pos] ||
  1282.     ( [lindex $tag 0] < [lineStart $pos0] && [lindex $tag 1] > [lineStart $pos0])} {
  1283.         set tag ""
  1284.     } else {
  1285.         set tag [string trim [eval getText $tag] "<>"]
  1286.     }
  1287.     set tag [string toupper [lindex $tag 0]]
  1288.     # Add to indentation?
  1289.     if {[lsearch -exact $indent $tag] >= 0} {
  1290.         set previndent [htmlIncreaseIndent $previndent]
  1291.     }
  1292.     # Find last tag on current line.
  1293.     set tag ""
  1294.     set lstart [lineStart $pos0]
  1295.     set lend [expr ([set npos [nextLineStart $pos0]] <= $lstart) ? $lstart : $npos - 1]
  1296.     regexp {<([^<>]+)>} [getText $lstart $lend] dum tag
  1297.     set tag [string toupper [lindex $tag 0]]
  1298.     
  1299.     # Reduce indentation?
  1300.     if {[string index $tag 0] == "/" && [lsearch -exact $indent [string range $tag 1 end]] >= 0} {
  1301.         set previndent [htmlReduceIndent $previndent]
  1302.     }
  1303.     return $previndent 
  1304. }
  1305.  
  1306. # Find the indentation the next line should have.
  1307. proc htmlFindNextIndent {{pos0 ""}} {
  1308.     global HTMLmodeVars htmlIndentElements
  1309.     set indent ""
  1310.     foreach i $htmlIndentElements {
  1311.         if {$HTMLmodeVars(indent$i)} {lappend indent $i}
  1312.     }
  1313.     if {$pos0 == ""} {set pos0 [getPos]}
  1314.     set ind [htmlFindIndent $pos0]
  1315.     # Find last tag before pos0 on current line.
  1316.     set tag ""
  1317.     set lstart [lineStart $pos0]
  1318.     regexp {<([^<>]+)>} [getText $lstart $pos0] dum tag
  1319.     set tag [string toupper [lindex $tag 0]]
  1320.     # Add to indentation?
  1321.     if {[lsearch -exact $indent $tag] >= 0} {set ind [htmlIncreaseIndent $ind]}
  1322.     return $ind
  1323. }
  1324.  
  1325. # get the leading whitespace of the current line
  1326. proc htmlGetIndent { pos } {
  1327.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  1328.     return [text::minSpaceForm [eval getText $res]]
  1329. }
  1330.  
  1331. # Adds indentationAmount whitespace.
  1332. proc htmlIncreaseIndent {indent} {
  1333.     global indentationAmount
  1334.     set in [string range "                               " 1 $indentationAmount]
  1335.     return [text::minSpaceForm "[text::maxSpaceForm $indent]$in"]
  1336. }
  1337.  
  1338. # Removes indentationAmount whitespace.
  1339. proc htmlReduceIndent {indent} {
  1340.     global indentationAmount
  1341.     return [text::minSpaceForm [string range [text::maxSpaceForm $indent] $indentationAmount end]]
  1342. }
  1343.  
  1344. proc htmlFirstLineIndent {indent} {
  1345.     if {![is::Whitespace [set text [getText [lineStart [getPos]] [getPos]]]]} {return $indent}
  1346.     set indent [text::minSpaceForm $indent]
  1347.     set text [text::minSpaceForm $text]
  1348.     return [string range $indent [string length $text] end]
  1349. }
  1350.  
  1351. proc htmlIndentChunk {text {tab ""}} {
  1352.     upvar $text txt
  1353.     if {$tab == ""} {set tab [text::Tab]}
  1354.     regsub -all {\[|\]} $txt {\\&} txt
  1355.     regsub -all "\r(\[ \t\]*)" $txt {\r[text::minSpaceForm "\1$tab"]} txt
  1356.     set txt [subst $txt]
  1357. }
  1358.  
  1359. #===============================================================================
  1360. # Tidy up source
  1361. #===============================================================================
  1362. proc htmlReformatParagraph {} {htmlTidyUp paragraph}
  1363. proc htmlReformatDocument {} {htmlTidyUp document}
  1364.  
  1365. proc htmlTidyUp {where} {
  1366.     global fillColumn
  1367.     htmlTidyUp2 $where $fillColumn
  1368. }
  1369.  
  1370. proc htmlTidyUp2 {where fillColumn} {
  1371.     global HTMLmodeVars htmlElemProc htmlIndentElements indentationAmount
  1372.     message "Reformatting…"
  1373.     set oldfillColumn $fillColumn
  1374.     if {$where == "paragraph"} {
  1375.         if {[isSelection]} {
  1376.             set startPos [getPos]
  1377.             set endPos [selEnd]
  1378.         } else {
  1379.             if {[catch {search -s -f 0 -m 0 -r 1 {^[ \t]*$} [getPos]} sp]} {set sp 0}
  1380.             set startPos [nextLineStart [lindex $sp 1]]
  1381.             if {[catch {search -s -f 1 -m 0 -r 1 {^[ \t]*$} [getPos]} sp]} {set sp "0 [maxPos]"}
  1382.             set endPos [expr [lindex $sp 1] < [maxPos] ? [lindex $sp 1] + 1 : [maxPos]]
  1383.         }
  1384.         # Avoid doing something inside STYLE and SCRIPT.
  1385.         foreach stsc {STYLE SCRIPT} {
  1386.             if {[htmlIsInContainer $stsc $startPos]} {
  1387.                 if {[catch {search -s -f 1 -m 0 -r 0 -i 1 "</$stsc>" $startPos} rrr]} {
  1388.                     message ""; return
  1389.                 } else {
  1390.                     set startPos [lindex $rrr 1]
  1391.                 }
  1392.             }
  1393.             if {[htmlIsInContainer $stsc $endPos]} {
  1394.                 if {[catch {search -s -f 0 -m 0 -r 1 -i 1 "<$stsc\[^<>\]*>" $endPos} rrr]} {
  1395.                     message ""; return
  1396.                 } else {
  1397.                     set endPos [lindex $rrr 0]
  1398.                 }
  1399.             } 
  1400.         }
  1401.         set ind [htmlFindIndent $startPos]
  1402.         set fillColumn [expr $oldfillColumn - [string length [text::maxSpaceForm $ind]]]
  1403.         set cr 2
  1404.     } else {
  1405.         set startPos 0
  1406.         set endPos [maxPos]
  1407.         set ind ""
  1408.         set cr 0
  1409.     }
  1410.     # Indent region if completely inside STYLE or SCRIPT.
  1411.     if {$startPos > $endPos} {indentRegion; return}
  1412.     # Remember position
  1413.     set pos [expr [getPos] > $startPos ? [getPos] : $startPos]
  1414.     set srem [expr $pos - 20 < $startPos ? $startPos : $pos - 20]
  1415.     set remember_str [quote::Regfind [getText $srem $pos ]]
  1416.     regsub -all {\?} $remember_str {\\?} remember_str
  1417.     regsub -all "\[ \t\r\]+" $remember_str {[ \t\r]+} remember_str
  1418.     # To handle indentation
  1419.     set indList ""
  1420.     foreach i $htmlIndentElements {
  1421.         if {$HTMLmodeVars(indent$i)} {lappend indList $i}
  1422.     }
  1423.     
  1424.     # These tags should have a blank line before
  1425.     set blBef {TITLE HEAD BODY STYLE H1 H2 H3 H4 H5 H6 P BLOCKQUOTE DIV CENTER PRE MULTICOL OBJECT
  1426.     NOEMBED UL OL DIR MENU DL FORM FIELDSET SELECT OPTGROUP TABLE TR FRAMESET NOFRAMES MAP APPLET SCRIPT NOSCRIPT LAYER NOLAYER}
  1427.     # These tags should have a cr before
  1428.     set crBef {/HTML /HEAD /BODY /STYLE /P /BLOCKQUOTE /DIV ADDRESS /CENTER /PRE /MULTICOL BDO INS DEL HR BASEFONT
  1429.     MARQUEE /OBJECT BGSOUND /NOEMBED /UL /OL /DIR /MENU LI /DL DT /FORM /FIELDSET LEGEND /SELECT /OPTGROUP OPTION BUTTON TEXTAREA
  1430.     KEYGEN /TABLE /TR CAPTION COL COLGROUP THEAD TBODY TFOOT /FRAMESET FRAME /NOFRAMES /MAP AREA
  1431.     /APPLET PARAM /SCRIPT /NOSCRIPT /LAYER ILAYER /NOLAYER BASE ISINDEX LINK META !--}
  1432.     # These tags should have a blank line after
  1433.     set blAft {/TITLE /HEAD /BODY /STYLE /H1 /H2 /H3 /H4 /H5 /H6 /P /BLOCKQUOTE /DIV /CENTER /PRE /MULTICOL
  1434.     /OBJECT /NOEMBED /UL /OL /DIR /MENU /DL /FORM /FIELDSET /SELECT /OPTGROUP /TABLE /TR /FRAMESET /NOFRAMES /MAP
  1435.     /APPLET /SCRIPT /NOSCRIPT /LAYER /NOLAYER}
  1436.     # These tags should have a cr after
  1437.     set crAft {HTML /HTML HEAD BODY STYLE P BLOCKQUOTE DIV /ADDRESS CENTER PRE MULTICOL BR HR WBR BASEFONT
  1438.     /MARQUEE OBJECT BGSOUND NOEMBED UL OL DIR MENU /LI DL /DD FORM FIELDSET /LEGEND INPUT SELECT /BUTTON OPTGROUP /TEXTAREA /BDO /INS /DEL KEYGEN
  1439.     TABLE TR /CAPTION COL COLGROUP THEAD TBODY TFOOT FRAMESET FRAME NOFRAMES MAP AREA APPLET PARAM
  1440.     SCRIPT NOSCRIPT LAYER /ILAYER NOLAYER BASE ISINDEX LINK META !-- !DOCTYPE}
  1441.     # Custom elements
  1442.     foreach c [array names htmlElemProc] {
  1443.         switch [lindex $htmlElemProc($c) 0] {
  1444.             htmlBuildCR2Elem {
  1445.                 lappend blBef $c
  1446.                 lappend crBef /$c
  1447.                 lappend blAft /$c
  1448.                 lappend crAft $c
  1449.             }
  1450.             htmlBuildCRElem {
  1451.                 if {[lindex $htmlElemProc($c) 2] == "1"} {
  1452.                     lappend blBef $c
  1453.                     lappend blAft /$c
  1454.                 } else {
  1455.                     lappend crBef $c
  1456.                     lappend crAft /$c
  1457.                 }
  1458.             }
  1459.             htmlBuildOpening {
  1460.                 if {[lindex $htmlElemProc($c) 2] == "1"} {lappend crBef $c}
  1461.                 if {[lindex $htmlElemProc($c) 3] == "1"} {lappend crAft $c}
  1462.             }
  1463.         }
  1464.     }
  1465.     set all [concat $blBef $blAft $crBef $crAft]
  1466.     set bef [concat $blBef $crBef]
  1467.     set aft [concat $blAft $crAft]
  1468.     set pos $startPos
  1469.     set tmp ""
  1470.     set text ""
  1471.     while {![catch {search -s -f 1 -m 0 -r 1 {(<!--|<[^<>]+>)} $pos} pos1] && [lindex $pos1 1] <= $endPos} {
  1472.         set tag [string toupper [lindex [set wholeTag [string trim [eval getText $pos1] "<>"]] 0]]
  1473.         if {$tag != "!--"} {
  1474.             set w ""
  1475.             set i {0 0}
  1476.             # To avoid line breaks inside attributes
  1477.             while {[regexp -indices {=\"[^ \"]* [^\"]*\"} $wholeTag i]} {
  1478.                 append w [string range $wholeTag 0 [expr [lindex $i 0] - 1]]
  1479.                 regsub -all "\[ \t\r\]+" [string range $wholeTag [lindex $i 0] [lindex $i 1]] "" w1
  1480.                 append w $w1
  1481.                 set wholeTag [string range $wholeTag [expr [lindex $i 1] + 1] end]
  1482.             }
  1483.             set wholeTag $w$wholeTag
  1484.         }
  1485.         append tmp [getText $pos [lindex $pos1 0]]
  1486.         set pos [lindex $pos1 1]            
  1487.         if {[lsearch $all $tag] < 0} {
  1488.             append tmp <$wholeTag>
  1489.             continue
  1490.         }
  1491.         # cr or blank line before tag
  1492.         if {[lsearch $bef $tag] >= 0} {
  1493.             regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1494.             set tmp [string trimright [breakIntoLines $tmp]]
  1495.             regsub -all "" $tmp " " tmp
  1496.             regsub -all "\r" $tmp "\r$ind" tmp
  1497.             if {![is::Whitespace $tmp]} {set cr 0; append text $ind}
  1498.             append text $tmp
  1499.             set ble [lsearch $blBef $tag]
  1500.             if {$cr == 1 && $ble >= 0 && ([string index $tag 0] != "/" || [lsearch $indList [string range $tag 1 end]] < 0)} {
  1501.                 append text $ind
  1502.             }
  1503.             if {$cr == 0} {
  1504.                 append text \r
  1505.                 incr cr
  1506.                 if {$cr == 1 && $ble >= 0} {append text $ind}
  1507.             }
  1508.             if {$ble >= 0 && $cr < 2} {append text \r; incr cr}
  1509.             set tmp <$wholeTag>
  1510.             # Take care of comments separately
  1511.             if {$tag == "!--"} {
  1512.                 set tmp "<!--"
  1513.                 if {[catch {search -s -f 1 -m 0 -r 1 -i 1 -- "-->" $pos} pos2]} {set pos2 "0 $endPos"}
  1514.                 append text $ind$tmp[getText $pos [set pos [lindex $pos2 1]]]
  1515.                 set tmp ""
  1516.                 set cr 0
  1517.             }
  1518.             # The contents of these tags should be left untouched
  1519.             if {[lsearch {SCRIPT STYLE PRE} $tag] >= 0} {
  1520.                 set tag /$tag
  1521.                 regsub -all "" $tmp " " tmp
  1522.                 if {[catch {search -s -f 1 -m 0 -r 1 -i 1 "<$tag>" $pos} pos2]} {set pos2 "0 $endPos"}
  1523.                 append text $ind$tmp[getText $pos [set pos [lindex $pos2 1]]]
  1524.                 set tmp ""
  1525.                 set cr 0
  1526.             }
  1527.         } else {
  1528.             append tmp <$wholeTag>
  1529.         }
  1530.         # cr or blank line after tag
  1531.         if {[lsearch $aft $tag] >= 0} {
  1532.             if {[string index $tag 0] == "/" && [lsearch $indList [string range $tag 1 end]] >= 0} {
  1533.                 set ind [htmlReduceIndent $ind]
  1534.                 set fillColumn [expr $oldfillColumn - [string length [text::maxSpaceForm $ind]]]
  1535.             }
  1536.             regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1537.             set tmp [string trimright [breakIntoLines $tmp]]
  1538.             regsub -all "" $tmp " " tmp
  1539.             regsub -all "\r" $tmp "\r$ind" tmp
  1540.             if {![is::Whitespace $tmp]} {set cr 0; append text $ind}
  1541.             append text $tmp
  1542.             set bla [lsearch $blAft $tag]
  1543.             if {[lsearch $indList $tag] >= 0} {
  1544.                 set ind [htmlIncreaseIndent $ind]
  1545.                 set fillColumn [expr $oldfillColumn - [string length [text::maxSpaceForm $ind]]]
  1546.             }
  1547.             if {$cr == 0} {
  1548.                 append text \r
  1549.                 incr cr
  1550.                 if {$cr == 1 && $bla >= 0} {append text $ind}
  1551.             }
  1552.             if {$bla >= 0 && $cr < 2} {append text \r; incr cr}
  1553.             set tmp ""
  1554.         }
  1555.     }
  1556.     # Add what's left
  1557.     if {$tmp != "" || $pos < $endPos} {
  1558.         if {$pos < $endPos} {append tmp [getText $pos $endPos]}
  1559.         regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1560.         set tmp [string trimright [breakIntoLines $tmp]]
  1561.         regsub -all "" $tmp " " tmp
  1562.         regsub -all "\r" $tmp "\r$ind" tmp
  1563.         if {![is::Whitespace $tmp]} {append text $ind}
  1564.         append text $tmp
  1565.         if {![is::Whitespace $tmp]} {append text \r}
  1566.     }
  1567.     replaceText $startPos $endPos $text
  1568.     # Go back to previous position.
  1569.     if { $remember_str != "" } {
  1570.         regexp -indices $remember_str [getText $startPos [set end [getPos]]] wholematch
  1571.         set p [expr [info exists wholematch] ? [expr $startPos + 1 + [lindex $wholematch 1]] : $end]
  1572.         goto [expr $p >= $end ? $end -1 : $p]
  1573.     }
  1574. }
  1575.